Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/Think Class Libraries/CProgressBar 1.2/CProgressBar.p

Text File | 1996-01-05 | 15.7 KB | 560 lines | [TEXT/PJMM]

{****************************************************}
{}
{        CProgressBar.p                                                                                                                                                                                                }
{}
{        SUPERCLASS = CPane                                                                                                                                                                            }
{}
{        Copyright © 1994 Johns Hopkins University. All rights reserved.                                        }
{}
{        Original Author:     Martin R. Wachter        email:    [e-mail]            }
{}
{        Modified:            4/27/94                by:        mrw            TCL Version:    1.1.3                                                        }
{        Created:            3/25/94                    by:        mrw            TCL Version:    1.1.3                                                        }
{}
{        Pascal Translation:    Patrick Hew                email:    [e-mail]                                }
{}
{        Modified:        3 Jan 1996            by:        phew            TCL Version: 1.1.2                                                            }
{        Created:            4 Dec 1994            by:        phew            TCL Version: 1.1.2                                                            }
{}
{        CProgressBar is a subclass of CPane which emulates the Finder's progress            }
{        bar when you copy files.  Use it like any other CPane subclass.                                                    }
{}
{        Call UpdateProgress with a percentage complete to "animate" the progress            }
{        fill area.}
{}
{        You can specify any RGB colors that you want for the background and the fill        }
{        bar areas of CProgressBar.  Call UseFinderProgressColors to use the same            }
{        colors that the Finder uses, or call UseSystemTinges for the System's color        }
{        tinges as set by the user in the Color CDEV.                                                                                                            }
{}
{        Important: If you creating a progress bar in a DLOG dialog as an overloaded            }
{        item, remember to override your application's ForceClassReferences method        }
{        to refer to CProgressBar. See CApplication.ForceClassReferences for details.    }
{        Thanks to Robert "lobsterman" Huber for detecting this error.                                                    }
{}
{        Version change history:                                                                                                                                                                        }
{    }
{    1.0        Initial release.                                                                                                                                                                                        }
{    1.1        FinderFillColor and FinderBackColor declared as separate functions.                        }
{                    This allows Finder colors to be set at the initialization stage.                                            }
{                    GetWindowTinges now a utility function instead of being a method.                            }
{                    Removed automatic creation of a frame border. Creating a border is                    }
{                    left to the programmer, being a separate object.                                                                                }
{                    Drawing and UpdateProgress revamped to handle shadowing of the bar                }
{                    correctly, and to reduce flickering during animation.                                                                    }
{ 1.2        Restructured into a single file.                                                                                                                                     }
{                    Draw now checks for using color (and hence for the presence of Color                }
{                    Quickdraw) before saving and restoring the foreground colour.                                        }
{}
{****************************************************}


unit CProgressBar;

interface

    uses
        TCL;

    { Synonyms for certain values. }

    const
        kDontUseColor = FALSE;
        kUseColor = TRUE;

        kHorizontal = FALSE;
        kVertical = TRUE;

        KNoShadow = FALSE;
        kShadow = TRUE;

    const
        SHADOW_DEPTH = 2;

    type
        CProgressBar = object(CPane)

                useShadow: Boolean;
                isVertical: Boolean;
                useColor: Boolean;
                itsRGBFillColor: RGBColor;
                itsRGBBackColor: RGBColor;
                itsPercent: Integer;
                itsFillRect: Rect;

                { Initialize a ProgressBar object. }
                procedure IProgressBar (anEnclosure: CView;
                                            aSupervisor: CBureaucrat;
                                            aWidth: Integer;
                                            aHeight: Integer;
                                            aHEncl: Integer;
                                            aVEncl: Integer;
                                            aHSizing: SizingOption;
                                            aVSizing: SizingOption;
                                            aColor: Boolean;
                                            aVertical: Boolean;
                                            aShadow: Boolean;
                                            rgbFColor: RGBColor;
                                            rgbBColor: RGBColor);

                { Initialize a ProgressBar object using a template. }
                procedure IViewTemp (anEnclosure: CView;
                                            aSupervisor: CBureaucrat;
                                            viewData: Ptr);
                override;

                { Use the same colors that the Finder 's progress bar uses. }
                procedure UseFinderProgressColors;

                { Use the System 's Highlight and Window colors for the fill and back colors. }
                procedure UseSystemTinges;

                { Draw the Progress bar. }
                procedure Draw (var area: Rect);
                override;

                { Given a percentage of completion, UpdateProgress will set itsFillRect to the }
                { appropriate size. The Draw method actually draws the fill bar. }
                { Animate the bar by multiple calls to UpdateProgress with different values. }
                { Horizontal growth is from left to right, vertical growth from bottom to top. }
                procedure UpdateProgress (percent: Integer);

            end; { CProgressBar }

    { ProgressBar template. }

    type
        ProgressBarTemp = record
                sPaneTemp: PaneTemp;
                color: Integer;        { The template stores a Boolean as two bytes. }
                vertical: Integer;    { Hence we have to read as an integer/short. }
                shadow: Integer;
                rgbFColor: RGBColor;    { These are just three integers. }
                rgbBColor: RGBColor;
            end;
        ProgressBarTempP = ^ProgressBarTemp;

    { Utility functions for getting colors. }
    { These are generic enough that one may wish to use them elsewhere, }
    { hence they have been unbundled from methods. }

    { Returns the RGB values for the Finder's fill color. }
    function FinderFillColor: RGBColor;

    { Returns the RGB values for the Finder's back color. }
    function FinderBackColor: RGBColor;

    { Returns the RGB values for the Finder's background color. }
    procedure GetWindowTinges (var lightTinge: RGBColor;
                                    var darkTinge: RGBColor);


implementation


{****************************************************}
{}
{        IProgressBar                                                                                                                                                                                                    }
{}
{        Initialize a ProgressBar object.                                                                                                                                             }
{}
{****************************************************}

    procedure CProgressBar.IProgressBar (anEnclosure: CView;
                                    aSupervisor: CBureaucrat;
                                    aWidth: Integer;
                                    aHeight: Integer;
                                    aHEncl: Integer;
                                    aVEncl: Integer;
                                    aHSizing: SizingOption;
                                    aVSizing: SizingOption;
                                    aColor: Boolean;
                                    aVertical: Boolean;
                                    aShadow: Boolean;
                                    rgbFColor: RGBColor;
                                    rgbBColor: RGBColor);

    begin { IProgressBar }
        IPane(anEnclosure, aSupervisor, aWidth, aHeight, aHEncl, aVEncl, aHSizing, aVSizing);

        useColor := aColor & gSystem.hasColorQD;
        isVertical := aVertical;
        useShadow := aShadow;
        itsRGBFillColor := rgbFColor;
        itsRGBBackColor := rgbBColor;

        itsPercent := 0;
    end; { IProgressBar }


{****************************************************}
{}
{        IViewTemp                                                                                                                                                                                                            }
{}
{        Initialize a ProgressBar object using a template.                                                                                            }
{}
{****************************************************}

    procedure CProgressBar.IViewTemp (anEnclosure: CView;
                                    aSupervisor: CBureaucrat;
                                    viewData: Ptr);

        var
            p: ProgressBarTempP;

    begin { IViewRes }
        p := ProgressBarTempP(viewData);

        { Initialize superclass. }

        inherited IViewTemp(anEnclosure, aSupervisor, @p^.sPaneTemp);

        { Set instance variables from template. }

        useColor := (p^.color <> 0) & gSystem.hasColorQD;
        isVertical := p^.vertical <> 0;
        useShadow := p^.shadow <> 0;
        itsRGBFillColor := p^.rgbFColor;
        itsRGBBackColor := p^.rgbBColor;

        itsPercent := 0;
    end; { IViewRes }


{****************************************************}
{}
{        UseFinderProgressColors                                                                                                                                                                }
{}
{        Use the same colors that the Finder 's progress bar uses.                                                                    }
{}
{****************************************************}

    procedure CProgressBar.UseFinderProgressColors;

    begin { UseFinderProgressColors }
        itsRGBFillColor := FinderFillColor;
        itsRGBBackColor := FinderBackColor;
    end; { UseFinderProgressColors }


{****************************************************}
{}
{        UseSystemTinges                                                                                                                                                                                        }
{}
{        Use the System 's Highlight and Window colors for the fill and back colors.                }
{}
{****************************************************}

    procedure CProgressBar.UseSystemTinges;

        var
            theBackColor, theFillColor: RGBColor;

    begin { UseSystemTinges }

        { Note that we can't pass itsRGBBackColor and itsRGBFillColor to GetWindowTinges by reference. }

        GetWindowTinges(theBackColor, theFillColor);
        itsRGBBackColor := theBackColor;
        itsRGBFillColor := theFIllColor;
    end; { UseSystemTinges }


{****************************************************}
{}
{        Draw                                                                                                                                                                                                                            }
{}
{        Draw the Progress bar.                                                                                                                                                                        }
{}
{****************************************************}

    procedure CProgressBar.Draw (var area: Rect);

        var
            pen: PenState;
            frameLR: LongRect;
            frameR, theFillR, paintR: Rect;
            savForeColor, nowColor, myBlackColor: RGBColor;

    begin { Draw }
        GetFrame(frameLR);
        LongToQDRect(frameLR, frameR);

        Prepare;
        GetPenState(pen);
        if useColor then begin
            GetForeColor(savForeColor);
        end; { if }
        PenNormal;

        { Paint the background. }

        if SectRect(frameR, area, paintR) then begin
            if useColor then begin
                nowColor := itsRGBBackColor;
                RGBForeColor(nowColor);
            end { if }
            else begin
                PenPat(white);
            end; { else if }
            PaintRect(paintR);
        end; { if }

        { Paint the fill area. }

        theFillR := itsFillRect;
        if SectRect(theFillR, area, paintR) then begin
            if useColor then begin
                nowColor := itsRGBFillColor;
                RGBForeColor(nowColor);
            end { if }
            else begin
                PenPat(gray);
            end; { if }
            PaintRect(paintR);
        end; { if }

        if useShadow & (itsPercent > 0) then begin

            if useColor then begin

                { The identifier BlackColor is used by QuickDraw for something different. }

                with myBlackColor do begin
                    red := $0000;
                    green := $0000;
                    blue := $0000;
                end; { with }
                RGBForeColor(myBlackColor);
            end { if }
            else begin
                PenPat(black);
            end; { else }

            { Recall that drawing is clipped to the pane of the frame. }
            { itsFillRect is correctly sized in UpdateProgress. }

            PenSize(SHADOW_DEPTH, SHADOW_DEPTH);

            MoveTo(itsFillRect.left + SHADOW_DEPTH, itsFillRect.bottom);
            LineTo(itsFillRect.right, itsFillRect.bottom);
            LineTo(itsFillRect.right, itsFillRect.top + SHADOW_DEPTH);

        end;     { if }

        { Reset settings. }

        SetPenState(pen);
        if useColor then begin
            RGBForeColor(savForeColor);
        end; { if }

    end; { Draw }


{****************************************************}
{}
{        UpdateProgress }
{}
{        Given a percentage of completion, UpdateProgress will set itsFillRect to the         }
{        appropriate size. The Draw method actually draws the fill bar.                                                    }
{}
{        Animate the bar by multiple calls to UpdateProgress with different values.            }
{        Horizontal growth is from left to right, vertical growth from bottom to top.        }
{}
{****************************************************}

    procedure CProgressBar.UpdateProgress (percent: Integer);

        var
            theFillRect, updateRect: Rect;
            rectWidth, rectHeight, barFill, oldFill: Integer;

    begin { UpdateProgress }

        { Update only if there is a change. }

        if itsPercent <> percent then begin

            GetLengths(rectWidth, rectHeight);

            if not isVertical then begin

                { We calculate barFill using integer processes to avoid numerical errors. }
                { However, multiplying rectWidth by percent may result in an overflow }
                { so we cast to LongInt first, then work back. }

                barFill := Integer(LongInt(rectWidth) * LongInt(percent) div 100);
                oldFill := Integer(LongInt(rectWidth) * LongInt(itsPercent) div 100);

                {  Growth from left to right. For intersection testing, work with respect to frame co-ordinates. }

                if percent > itsPercent then begin
                    SetRect(updateRect, oldFill, 0, barFill, rectHeight);
                end { if }
                else begin
                    SetRect(updateRect, barFill, 0, oldFill, rectHeight);
                end; { else }

                { If there is to be a shadow, define the bar width so that we can see it. }

                if useShadow then begin
                    SetRect(theFillRect, 0, 0, barFill, rectHeight - SHADOW_DEPTH);
                end { if }
                else begin
                    SetRect(theFillRect, 0, 0, barFill, rectHeight);
                end; { else }

            end { if }
            else begin

                { We calculate barFill using integer processes to avoid numerical errors. }
                { However, multiplying rectHeight by percent may result in in an overflow }
                { so we cast to LongInt first, then work back. }

                barFill := Integer(LongInt(rectHeight) * LongInt(percent) div 100);
                oldFill := Integer(LongInt(rectHeight) * LongInt(itsPercent) div 100);

                { Growth from top to bottom. }

                if percent > itsPercent then begin
                    SetRect(updateRect, 0, rectHeight - barFill, rectWidth, rectHeight - oldFill);
                end { if }
                else begin
                    SetRect(updateRect, 0, rectHeight - oldFill, rectWidth, rectHeight - barFill);
                end; { else }

                { If there is to be a shadow, define the bar height so that we can see it. }

                if useShadow then begin
                    SetRect(theFillRect, 0, rectHeight - barFill, rectWidth - SHADOW_DEPTH, rectHeight);
                end { if }
                else begin
                    SetRect(theFillRect, 0, rectHeight - barFill, rectWidth, rectHeight);
                end; { else }

            end; { else }

            { Remember - Never pass an instance variable as a parameter by reference, }
            { unless you are absolutely sure that no memory is going to be shifted. }
            { We can remove any doubt by using theFillRect as a temporary variable.    }

            itsFillRect := theFillRect;

            itsPercent := percent;

            Draw(updateRect);
        end; { if }
    end; { UpdateProgress }


{****************************************************}
{}
{        FinderFillColor                                                                                                                                                                                                }
{}
{        Returns the RGB values for the Finder's fill color.                                                                                         }
{}
{****************************************************}

    function FinderFillColor: RGBColor;

        var
            theColor: RGBColor;

    begin { FinderFillColor }
        with theColor do begin
            red := 17476;
            green := 17476;
            blue := 17476;
        end; { with }
        FinderFillColor := theColor;
    end; { FinderFillColor }


{****************************************************}
{}
{        FinderBackColor                                                                                                                                                                                            }
{}
{        Returns the RGB values for the Finder's back color.                                                                                     }
{}
{****************************************************}

    function FinderBackColor: RGBColor;

        var
            theColor: RGBColor;

    begin { FinderBackColor }
        with theColor do begin
            red := Integer(52428);
            green := Integer(52428);
            blue := Integer(65535);
        end; { with }
        FinderBackColor := theColor;
    end; { FinderBackColor }


{****************************************************}
{}
{        GetWindowTinges                                                                                                                                                                                        }
{}
{        Returns the RGB values for the Finder's background color.                                                                }
{}
{****************************************************}

    procedure GetWindowTinges (var lightTinge: RGBColor;
                                    var darkTinge: RGBColor);

        var
            windowCTable: CTabHandle;

    begin { GetWindowTinges }
        { Get the current colour lookup table. }

        windowCTable := CTabHandle(GetResource('wctb', 0));

        if windowCTable <> nil then begin

            { Note about compiler directives - ctTable is of }
            { type CSpecArray, which has array indices 0..0 }
            { However, if the resource is not nil, then we know }
            { that we can retrieve the colors that we want by }
            { accessing indices 11 and 12. }
            { Is there is a way to do this more cleanly? }

{$PUSH}
{$R-}
            lightTinge := windowCTable^^.ctTable[11].rgb;
            darkTinge := windowCTable^^.ctTable[12].rgb;
{$POP}

            { Case for black and white window defs under system 7, both return black! }

            with lightTinge do begin
                if (red = $0000) & (green = $0000) & (blue = $0000) then begin
                    red := $ffff;
                    green := $ffff;
                    blue := $ffff;
                end; { if }
            end; { with }
        end { if }
        else begin

            { No window colour table, make black and white. }

            with lightTinge do begin
                red := $ffff;
                green := $ffff;
                blue := $ffff;
            end; { with }
            with darkTinge do begin
                red := $0000;
                green := $0000;
                blue := $0000;
            end; { with }
        end; { else }

    end; { GetWindowTinges }


end. { CProgressBar }